home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / gptx-0_2.lha / gptx-0.2 / boxes.el next >
Lisp/Scheme  |  1991-10-10  |  10KB  |  355 lines
  1. ;;; Boxed comments for C mode.
  2. ;;; Copyright (C) 1991 Free Software Foundation, Inc.
  3. ;;; Francois Pinard <pinard@iro.umontreal.ca>, April 1991.
  4. ;;;
  5. ;;; I use this hack is by putting, in my .emacs file:
  6. ;;;
  7. ;;;    (setq c-mode-hook
  8. ;;;          '(lambda ()
  9. ;;;         (define-key c-mode-map "\M-q" 'reindent-c-comment)))
  10. ;;;    (autoload 'reindent-c-comment "boxes" nil t)
  11. ;;;
  12. ;;; The cursor should be within a comment before reindent-c-comment to
  13. ;;; be given, or else it should be between two comments, in which case
  14. ;;; the command applies to the next comment.  When the command is
  15. ;;; given without prefix, the current comment box type is recognized
  16. ;;; and preserved.  Given 0 as a prefix, the comment box disappears
  17. ;;; and the comment stays between a single opening `/*' and a signle
  18. ;;; closing `*/'.  Given 1 or 2 as a prefix, a single or doubled lined
  19. ;;; comment box is forced.  Given 3 as a prefix, a Taarna style box is
  20. ;;; forced, but you do not even want to hear about those.
  21. ;;;
  22. ;;; I observed rounded corners first in some code from Warren Tucker
  23. ;;; <wht@n4hgf.Mt-Park.GA.US>.
  24.  
  25. (defvar c-mode-taarna-style nil "*Non-nil for Taarna team C-style.")
  26. (defvar c-comment-box-style 'single "*Preferred style for box comments.")
  27.  
  28. ;;; Set or reset the Taarna team C mode style.
  29.  
  30. (defun taarna-mode ()
  31.   (interactive)
  32.   (if c-mode-taarna-style
  33.       (progn
  34.  
  35.     (setq c-mode-taarna-style nil)
  36.     (setq c-indent-level 2)
  37.     (setq c-continued-statement-offset 2)
  38.     (setq c-brace-offset 0)
  39.     (setq c-argdecl-indent 5)
  40.     (setq c-label-offset -2)
  41.     (setq c-tab-always-indent t)
  42.     (setq c-auto-newline nil)
  43.     (setq c-comment-box-style 'single)
  44.     (message "C mode: GNU style"))
  45.     
  46.     (setq c-mode-taarna-style t)
  47.     (setq c-indent-level 4)
  48.     (setq c-continued-statement-offset 4)
  49.     (setq c-brace-offset -4)
  50.     (setq c-argdecl-indent 4)
  51.     (setq c-label-offset -4)
  52.     (setq c-tab-always-indent t)
  53.     (setq c-auto-newline t)
  54.     (setq c-comment-box-style 'taarna)
  55.     (message "C mode: Taarna style")))
  56.  
  57. ;;; Return the minimum value of the left margin of all lines, or -1 if
  58. ;;; all lines are empty.
  59.  
  60. (defun buffer-left-margin ()
  61.   (let ((margin -1))
  62.     (goto-char (point-min))
  63.     (while (not (eobp))
  64.       (skip-chars-forward " \t")
  65.       (if (not (looking-at "\n"))
  66.       (setq margin
  67.         (if (< margin 0)
  68.             (current-column)
  69.           (min margin (current-column)))))
  70.       (forward-line 1))
  71.     margin))
  72.  
  73. ;;; Return the maximum value of the right margin of all lines.  Any
  74. ;;; sentence ending a line has a space guaranteed before the margin.
  75.  
  76. (defun buffer-right-margin ()
  77.   (let ((margin 0) period)
  78.     (goto-char (point-min))
  79.     (while (not (eobp))
  80.       (end-of-line)
  81.       (if (bobp)
  82.       (setq period 0)
  83.     (backward-char 1)
  84.     (setq period (if (looking-at "[.?!]") 1 0))
  85.     (forward-char 1))
  86.       (setq margin (max margin (+ (current-column) period)))
  87.       (forward-char 1))
  88.     margin))
  89.  
  90. ;;; Indent or reindent a C comment box.  
  91.  
  92. (defun reindent-c-comment (flag)
  93.   (interactive "P")
  94.   (save-restriction
  95.     (let ((marked-point (point-marker))
  96.       (saved-point (point))
  97.       box-style left-margin right-margin)
  98.  
  99.       ;; First, find the limits of the block of comments following or
  100.       ;; enclosing the cursor, or return an error if the cursor is not
  101.       ;; within such a block of comments, and narrow the buffer.
  102.  
  103.       ;; - insure the point is into the following comment, if any
  104.  
  105.       (skip-chars-forward " \t\n")
  106.       (if (looking-at "/\\*")
  107.       (forward-char 2))
  108.  
  109.       (let ((here (point)) start end temp)
  110.  
  111.     ;; - identify a minimal comment block
  112.  
  113.     (search-backward "/*")
  114.     (setq temp (point))
  115.     (beginning-of-line)
  116.     (setq start (point))
  117.     (skip-chars-forward " \t")
  118.     (if (< (point) temp)
  119.         (progn
  120.           (goto-char saved-point)
  121.           (error "text before comment's start")))
  122.     (search-forward "*/")
  123.     (setq temp (point))
  124.     (end-of-line)
  125.     (forward-char 1)
  126.     (setq end (point))
  127.     (skip-chars-backward " \t\n")
  128.     (if (> (point) temp)
  129.         (progn
  130.           (goto-char saved-point)
  131.           (error "text after comment's end")))
  132.     (if (< end here)
  133.         (progn
  134.           (goto-char saved-point)
  135.           (error "outside any comment block")))
  136.  
  137.     ;; - try to extend the comment block backwards
  138.  
  139.     (goto-char start)
  140.     (while (and (not (bobp))
  141.             (progn (previous-line 1)
  142.                (beginning-of-line)
  143.                (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")))
  144.       (setq start (point)))
  145.  
  146.     ;; - try to extend the comment block forward
  147.  
  148.     (goto-char end)
  149.     (while (looking-at "[ \t]*/\\*.*\\*/[ \t]*$")
  150.       (forward-line 1)
  151.       (beginning-of-line)
  152.       (setq end (point)))
  153.  
  154.     ;; - narrow the whole block of comments
  155.  
  156.     (narrow-to-region start end))
  157.  
  158.       ;; Second, remove all the comment marks, and move all the text
  159.       ;; rigidly to the left to insure the left margin stays at the
  160.       ;; same place.  At the same time, recognize and save the box
  161.       ;; style in BOX-STYLE.
  162.  
  163.       (let ((previous-margin (buffer-left-margin))
  164.         actual-margin)
  165.     
  166.     ;; - remove all comment marks
  167.  
  168.     (goto-char (point-min))
  169.     (replace-regexp "\\*/[ \t]*/\\*" " ")
  170.     (goto-char (point-min))
  171.     (while (not (eobp))
  172.       (skip-chars-forward " \t")
  173.       (if (looking-at "/\\*")
  174.           (replace-match "  ")
  175.         (if (looking-at "|")
  176.         (replace-match " ")))
  177.       (end-of-line)
  178.       (skip-chars-backward " \t")
  179.       (backward-char 2)
  180.       (if (looking-at "\\*/")
  181.           (replace-match "")
  182.         (forward-char 1)
  183.         (if (looking-at "|")
  184.         (replace-match "")
  185.           (forward-char 1)))
  186.       (forward-line 1))
  187.  
  188.     ;; - remove the first and last dashed lines
  189.  
  190.     (setq box-style 'plain)
  191.     (goto-char (point-min))
  192.     (if (looking-at "^[ \t]*-*[.\+\\]?[ \t]*\n")
  193.         (progn
  194.           (setq box-style 'single)
  195.           (replace-match ""))
  196.       (if (looking-at "^[ \t]*=*[.\+\\]?[ \t]*\n")
  197.           (progn
  198.         (setq box-style 'double)
  199.         (replace-match ""))))
  200.     (goto-char (point-max))
  201.     (previous-line 1)
  202.     (beginning-of-line)
  203.     (if (looking-at "^[ \t]*[`\+\\]?*[-=]+[ \t]*\n")
  204.         (progn
  205.           (if (eq box-style 'plain)
  206.           (setq box-style 'taarna))
  207.           (replace-match "")))
  208.  
  209.     ;; - remove all spurious whitespace
  210.  
  211.     (goto-char (point-min))
  212.     (replace-regexp "[ \t]+$" "")
  213.     (goto-char (point-min))
  214.     (if (looking-at "\n+")
  215.         (replace-match ""))
  216.     (goto-char (point-max))
  217.     (skip-chars-backward "\n")
  218.     (if (looking-at "\n\n+")
  219.         (replace-match "\n"))
  220.     (goto-char (point-min))
  221.     (replace-regexp "\n\n\n+" "\n\n")
  222.     
  223.     ;; - move the text left is adequate
  224.  
  225.     (setq actual-margin (buffer-left-margin))
  226.     (if (not (= previous-margin actual-margin))
  227.         (indent-rigidly (point-min) (point-max)
  228.                 (- previous-margin actual-margin))))
  229.  
  230.       ;; Third, select the new box style from the old box style and
  231.       ;; the argument, choose the margins for this style and refill
  232.       ;; each paragraph.
  233.  
  234.       ;; - modify box-style only if flag is defined
  235.  
  236.       (if flag
  237.       (setq box-style
  238.         (cond ((eq flag '0) 'plain)
  239.               ((eq flag '1) 'single)
  240.               ((eq flag '2) 'double)
  241.               ((eq flag '3) 'taarna)
  242.               (c-mode-taarna-style 'taarna)
  243.               (t 'single))))
  244.  
  245.       ;; - compute the left margin
  246.  
  247.       (setq left-margin (buffer-left-margin))
  248.  
  249.       ;; - temporarily set the fill prefix and column, then refill
  250.  
  251.       (let ((fill-prefix (make-string left-margin ? ))
  252.         (fill-column (- fill-column
  253.                 (if (memq box-style '(single double)) 4 6))))
  254.     (fill-region (point-min) (point-max)))
  255.  
  256.       ;; - compute the right margin after refill
  257.  
  258.       (setq right-margin (buffer-right-margin))
  259.  
  260.       ;; Fourth, put the narrowed buffer back into a comment box,
  261.       ;; according to the value of box-style.  Values may be:
  262.       ;;    plain: insert between a single pair of comment delimiters
  263.       ;;    single: complete box, overline and underline with dashes
  264.       ;;    double: complete box, overline and underline with equal signs
  265.       ;;    taarna: comment delimiters on each line, underline with dashes
  266.           
  267.       ;; - move the right margin to account for left inserts
  268.  
  269.       (setq right-margin (+ right-margin
  270.                 (if (memq box-style '(single double))
  271.                 2
  272.                   3)))
  273.  
  274.       ;; - construct the box comment, from top to bottom
  275.  
  276.       (goto-char (point-min))
  277.       (cond ((eq box-style 'plain)
  278.  
  279.          ;; - construct a plain style comment
  280.  
  281.          (skip-chars-forward " " (+ (point) left-margin))
  282.          (insert (make-string (- left-margin (current-column)) ? )
  283.              "/* ")
  284.          (end-of-line)
  285.          (forward-char 1)
  286.          (while (not (eobp))
  287.            (skip-chars-forward " " (+ (point) left-margin))
  288.            (insert (make-string (- left-margin (current-column)) ? )
  289.                "   ")
  290.            (end-of-line)
  291.            (forward-char 1))
  292.          (backward-char 1)
  293.          (insert "  */"))
  294.         ((eq box-style 'single)
  295.  
  296.          ;; - construct a single line style comment
  297.  
  298.          (indent-to left-margin)
  299.          (insert "/*")
  300.          (insert (make-string (- right-margin (current-column)) ?-)
  301.              "-.\n")
  302.          (while (not (eobp))
  303.            (skip-chars-forward " " (+ (point) left-margin))
  304.            (insert (make-string (- left-margin (current-column)) ? )
  305.                "| ")
  306.            (end-of-line)
  307.            (indent-to right-margin)
  308.            (insert " |")
  309.            (forward-char 1))
  310.          (indent-to left-margin)
  311.          (insert "`")
  312.          (insert (make-string (- right-margin (current-column)) ?-)
  313.              "*/\n"))
  314.         ((eq box-style 'double)
  315.  
  316.          ;; - construct a double line style comment
  317.  
  318.          (indent-to left-margin)
  319.          (insert "/*")
  320.          (insert (make-string (- right-margin (current-column)) ?=)
  321.              "=\\\n")
  322.          (while (not (eobp))
  323.            (skip-chars-forward " " (+ (point) left-margin))
  324.            (insert (make-string (- left-margin (current-column)) ? )
  325.                "| ")
  326.            (end-of-line)
  327.            (indent-to right-margin)
  328.            (insert " |")
  329.            (forward-char 1))
  330.          (indent-to left-margin)
  331.          (insert "\\")
  332.          (insert (make-string (- right-margin (current-column)) ?=)
  333.              "*/\n"))
  334.         ((eq box-style 'taarna)
  335.  
  336.          ;; - construct a Taarna style comment
  337.  
  338.          (while (not (eobp))
  339.            (skip-chars-forward " " (+ (point) left-margin))
  340.            (insert (make-string (- left-margin (current-column)) ? )
  341.                "/* ")
  342.            (end-of-line)
  343.            (indent-to right-margin)
  344.            (insert " */")
  345.            (forward-char 1))
  346.          (indent-to left-margin)
  347.          (insert "/* ")
  348.          (insert (make-string (- right-margin (current-column)) ?-)
  349.              " */\n"))
  350.         (t (error "unknown box style")))
  351.  
  352.       ;; Fifth, restore the point position.
  353.  
  354.       (goto-char (marker-position marked-point)))))
  355.